home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SAVESCRN.SWG / 0008_SAVE8.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  98 lines
  1. {> Basically all I'm asking For are SaveScreen and
  2. > RestoreScreen Procedures. Procedures capable of just
  3. > partial screen saves and restores would be even better,
  4. > but anything will do!  :-)
  5. }
  6. Program SaveScr;
  7.  
  8. Uses
  9.   Crt,
  10.   Dos;
  11.  
  12. Const
  13.   vidseg : Word = $B800;
  14.   ismono : Boolean = False;
  15.  
  16. Type
  17.   Windowrec = Array [0..4003] Of
  18.   Byte;
  19.  
  20. Var
  21.   NewWindow : Windowrec;
  22.   c : Char;
  23.  
  24. Procedure checkvidseg;
  25. begin
  26.   If (mem [$0000 : $0449] = 7) Then
  27.      vidseg := $B000
  28.   Else
  29.      vidseg := $B800;
  30.   ismono := (vidseg = $B000);
  31. end;
  32.  
  33. Procedure savescreen (Var wind : Windowrec;
  34.   TLX, TLY, BRX, BRY : Integer);
  35. Var x, y, i : Integer;
  36. begin
  37.   checkvidseg;
  38.   wind [4000] := TLX;
  39.   wind [4001] := TLY;
  40.   wind [4002] := BRX;
  41.   wind [4003] := BRY;
  42.   i := 0;
  43.   For y := TLY To BRY Do
  44.       For x := TLX To BRX Do
  45.           begin
  46.           InLine ($FA);
  47.           wind [i] := mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) ];
  48.           wind [i + 1] := mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) + 1];
  49.           InLine ($FB);
  50.           Inc (i, 2);
  51.           end;
  52. end;
  53.  
  54. Procedure setWindow (Var wind : Windowrec;
  55.   TLX, TLY, BRX, BRY : Integer);
  56. Var i : Integer;
  57. begin
  58.   savescreen (wind, TLX, TLY, BRX, BRY);
  59.   Window (TLX, TLY, BRX, BRY);
  60.   ClrScr;
  61. end;
  62.  
  63. Procedure removeWindow (wind : Windowrec);
  64. Var TLX, TLY, BRX, BRY, x, y, i : Integer;
  65. begin
  66.   checkvidseg;
  67.   Window (1, 1, 80, 25);
  68.   TLX := wind [4000];
  69.   TLY := wind [4001];
  70.   BRX := wind [4002];
  71.   BRY := wind [4003];
  72.   i := 0;
  73.   For y := TLY To BRY Do
  74.       For x := TLX To BRX Do
  75.           begin
  76.           InLine ($FA);
  77.           mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) ] := wind [i];
  78.           mem [vidseg : (160 * (y - 1) + 2 * (x - 1) ) + 1] := wind [i + 1];
  79.           InLine ($FB);
  80.           Inc (i, 2);
  81.           end;
  82. end;
  83.  
  84. begin
  85.   setWindow (NewWindow, 1, 1, 80, 25);
  86.   GotoXY(1, 12);
  87.   Write ('Press a key to restore original screen...');
  88.   Repeat
  89.   Until KeyPressed;
  90.   c := ReadKey;
  91.   removeWindow (NewWindow);
  92.   GotoXY (1, 24);
  93. end.
  94.  
  95. {
  96. You can set the size of the Window to whatever you want, and save/restore as
  97. many Windows as you have memory available.
  98. }